﻿Imports System.Threading
Imports System.Net
Imports System.IO
Imports System.Xml
Imports System.Text
Imports HtmlParserSharp
Imports System.Runtime.Serialization.Json
Imports System.Configuration
Imports NLog
Imports NLog.Config

Public Class gkParser

    Private p_Doc As XmlDocument
    Private p_Cookies As CookieContainer
    Private p_Parser As SimpleHtmlParser
    Private p_contentType As String
    Private p_tag2ExcInstruction As String
    Private p_tag2IncInstruction As String
    Private p_tag2exclude As ArrayList
    Private p_tag2include As Hashtable
    Private LogMgr As NLog.Logger

    Public Sub New()
        Dim conf As Config.LoggingConfiguration = New LoggingConfiguration
        LogManager.Configuration = conf
        LogManager.Configuration.AddTarget("f1", New Targets.FileTarget With {.FileName = "batch.log"})
        LogManager.Configuration.AddTarget("c", New Targets.ConsoleTarget With {.Layout = "${longdate} ${callsite} ${level} ${message}"})
        LogManager.Configuration.LoggingRules.Add(New LoggingRule("*", LogLevel.Debug, LogManager.Configuration.FindTargetByName("f1")))
        LogManager.Configuration.LoggingRules.Add(New LoggingRule("*", LogLevel.Debug, LogManager.Configuration.FindTargetByName("c")))
        LogManager.ReconfigExistingLoggers()

        Dim l As Logger = LogManager.GetLogger("Main")

        internal_new(l)
    End Sub
    Friend Sub New(ByVal LogMgr As NLog.Logger)
        internal_new(LogMgr)
    End Sub

    Private Sub internal_new(ByVal LogMgr As NLog.Logger)
        Me.LogMgr = LogMgr

        p_Parser = New SimpleHtmlParser
        LogMgr.Trace("SimpleHtmlParser created.")

        p_tag2ExcInstruction = "SCRIPT|META|LINK|STYLE"
        p_tag2IncInstruction = "A:href|IMG:src,alt|INPUT:type,value,name"
        LoadPreferences()

    End Sub
    Public Property ExcludeInstructions() As String
        Get
            Return p_tag2ExcInstruction
        End Get
        Set(ByVal value As String)
            p_tag2ExcInstruction = value.ToUpper
            LoadPreferences()
        End Set
    End Property
    Public Property IncludeInstructions() As String
        Get
            Return p_tag2IncInstruction
        End Get
        Set(ByVal value As String)
            p_tag2IncInstruction = value.ToUpper
            LoadPreferences()
        End Set
    End Property

    Private Sub LoadPreferences()
        Dim tmp As String
        Dim tmpa As String()

        Try

            p_tag2exclude = New ArrayList

            tmp = p_tag2ExcInstruction
            tmpa = tmp.Split("|")
            p_tag2exclude.AddRange(tmpa)

            p_tag2include = New Hashtable
            tmp = p_tag2IncInstruction
            tmpa = tmp.Split("|")
            For Each tag_string As String In tmpa
                Dim atts As ArrayList
                Dim tmparr As String()
                Dim tag As String
                atts = New ArrayList
                tmparr = tag_string.Split(":")
                tag = tmparr(0)
                atts.AddRange(tmparr(1).Split(","))
                p_tag2include.Add(tag, atts)
            Next

        Catch ex As Exception
            LogMgr.ErrorException("Error loading parser preferences.", ex)
        End Try

    End Sub

    Public ReadOnly Property Document() As XmlDocument
        Get
            Return p_Doc
        End Get
    End Property
    Public ReadOnly Property ContentType() As String
        Get
            Return p_contentType
        End Get
    End Property

    Public Sub Navigate(ByVal url As String)
        Navigate(url, Nothing, False)
    End Sub
    Public Sub Navigate(ByVal url As String, ByVal dontParse As Boolean)
        Navigate(url, Nothing, dontParse)
    End Sub
    Public Sub Navigate(ByVal url As String, ByVal postData As String)
        Navigate(url, postData, False)
    End Sub
    Public Sub Navigate(ByVal url As String, ByVal postData As String, ByVal dontParse As Boolean)

        Dim text As String = String.Empty
        Dim type As String = "GET"
        If (Not postData Is Nothing AndAlso postData <> String.Empty) Then
            type = "POST"
        End If

        If (p_Cookies Is Nothing) Then
            p_Cookies = New CookieContainer()
        End If

        text = GetData(type, url, postData, p_Cookies)

        If Me.p_contentType = "application/json" Then
            StartParsingJson(text)
        Else

            Dim f As FileStream = New FileStream("debug.html", FileMode.Create)
            Dim sw As StreamWriter = New StreamWriter(f)
            sw.Write(text)
            sw.Close()

            StartParsingHtml(text)

        End If



    End Sub

    Public Sub Download(ByVal url As String, ByVal fullpath As String)

        Dim request As System.Net.HttpWebRequest
        Dim a() As String
        Dim fname As String
        Dim response As HttpWebResponse = Nothing
        Dim receiveStream As Stream
        Dim br As BinaryReader
        Dim fout As FileStream
        Dim fsw As BinaryWriter

        a = Split(url, "/")
        fname = a(UBound(a))
        If fullpath <> "" Then
            fname = fullpath
            fname = Replace(fname, "/", "-")
        End If

retry:
        Try

            request = HttpWebRequest.Create(url)
            request.Timeout = 60000
            request.MaximumAutomaticRedirections = 4
            request.MaximumResponseHeadersLength = 4
            request.Credentials = CredentialCache.DefaultCredentials

            response = CType(request.GetResponse(), HttpWebResponse)

        Catch wex As WebException
            Throw wex

        Catch ex As Exception
            LogMgr.ErrorException("Error during download. (" & url & ")", ex)
        End Try

        receiveStream = response.GetResponseStream()
        br = New BinaryReader(receiveStream)

        fout = New FileStream(fullpath, FileMode.Create)
        fsw = New BinaryWriter(fout)
        Try
            fsw.Write(br.ReadBytes(response.ContentLength))
        Catch wex As WebException
            If wex.Status = WebExceptionStatus.Timeout Then
                GoTo retry
            End If
        Finally
            fout.Close()
        End Try

        fsw.Close()
        response.Close()
        br.Close()

    End Sub
    Public Function DownloadToString(ByVal url As String) As String

        Dim request As System.Net.HttpWebRequest
        Dim a() As String
        Dim fname As String
        Dim ret As String

        a = Split(url, "/")
        fname = a(UBound(a))

        request = HttpWebRequest.Create(url)
        request.Timeout = 30000
        request.MaximumAutomaticRedirections = 4
        request.MaximumResponseHeadersLength = 4
        request.Credentials = CredentialCache.DefaultCredentials

        Dim response As HttpWebResponse = CType(request.GetResponse(), HttpWebResponse)
        Dim receiveStream As Stream = response.GetResponseStream()

        Dim br As New StreamReader(receiveStream)
        ret = br.ReadToEnd()

        response.Close()
        br.Close()

        Return ret

    End Function

    Private Function GetData(ByVal type As String, ByVal url As String, ByVal data As String, ByVal cookies As CookieContainer) As String

        Dim dataStream As Stream

        ' Create a request using a URL that can receive a post. 
        Dim request As HttpWebRequest = WebRequest.Create(url)
        request.CookieContainer = cookies
        request.AllowAutoRedirect = True
        request.Method = type
        If (type = "POST") Then
            Dim postData As String = data
            Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
            request.ContentType = "application/x-www-form-urlencoded"
            request.ContentLength = byteArray.Length
            dataStream = request.GetRequestStream()
            dataStream.Write(byteArray, 0, byteArray.Length)
            dataStream.Close()
        End If

        LogMgr.Trace("Sending {0} request.", type)
        Dim response As HttpWebResponse = request.GetResponse()
        cookies.Add(response.Cookies)

        ' Display the status.
        LogMgr.Trace("Response status: {0}", response.StatusDescription)
        LogMgr.Trace("Headers:")
        For i As Integer = 0 To response.Headers.Count - 1
            If response.Headers.AllKeys(i) = "Content-Type" Then
                Me.p_contentType = response.Headers(i)
            End If
            LogMgr.Trace(response.Headers.AllKeys(i) & "=" & response.Headers(i))
        Next

        LogMgr.Trace("Cookies received: {0}", response.Cookies.Count)
        For Each cook As Cookie In response.Cookies
            LogMgr.Trace("Cookie:")
            LogMgr.Trace(" {0} = {1}", cook.Name, cook.Value)
            LogMgr.Trace(" Domain: {0}", cook.Domain)
            LogMgr.Trace(" Path: {0}", cook.Path)
            LogMgr.Trace(" Port: {0}", cook.Port)
            LogMgr.Trace(" Secure: {0}", cook.Secure)
            LogMgr.Trace(" When issued: {0}", cook.TimeStamp)
            LogMgr.Trace(" Expires: {0} (expired? {1})", cook.Expires, cook.Expired)
            LogMgr.Trace(" Don't save: {0}", cook.Discard)
            LogMgr.Trace(" Comment: {0}", cook.Comment)
            LogMgr.Trace(" Uri for comments: {0}", cook.CommentUri)
            LogMgr.Trace(" Version: RFC {0}", IIf(cook.Version = 1, "2109", "2965"))
            LogMgr.Trace(" String: {0}", cook.ToString())
        Next

        dataStream = response.GetResponseStream()
        Dim reader As StreamReader = New StreamReader(dataStream)
        Dim responseFromServer As String = reader.ReadToEnd()
        'LogMgr.Trace (responseFromServer)

        reader.Close()
        dataStream.Close()
        response.Close()

        Return responseFromServer

    End Function
    Private Sub StartParsingHtml(ByVal html As String)

        Dim xmld As XmlDocument
        'Try
        xmld = p_Parser.ParseString(html)
        ''xmld.Save("gkParser_debug.xml")
        'Catch ex As Exception
        'Throw ex
        'End Try

        p_Doc = New XmlDocument()
        'Dim docel As XmlElement = p_Doc.CreateElement("DOCEL")
        'p_Doc.AppendChild(docel)
        ExploreHtml(xmld.DocumentElement, p_Doc)

    End Sub
    Private Sub ExploreHtml(ByVal docn As XmlNode, ByVal outel As XmlNode)

        Dim tag As String
        Dim outn As XmlNode

        'se è un tipo testo lo aggiungo.
        If TypeOf docn Is Xml.XmlText Then
            'Debug.Print(Asc(docn.Value))
            outn = p_Doc.CreateTextNode(docn.Value)

        Else
            Dim docel As XmlElement
            docel = docn
            tag = docel.Name.ToUpper

            ''''DEBUG
            If tag = "PRE" Then
                If docel.GetAttribute("class") = "de1" Then
                    Debug.Assert(True)
                End If
            End If
            ''''DEBUG

            'EXCLUDED TAGS
            If Me.p_tag2exclude.Contains(tag) Then
                Return
            End If

            'se non è da scartare creo un elemento
            outn = p_Doc.CreateElement(tag)


            'DEFAULT ARRIBUTES
            Dim a As XmlAttribute
            Dim outa As XmlAttribute
            a = docel.GetAttributeNode("id")
            If Not a Is Nothing Then
                outa = p_Doc.CreateAttribute("id")
                outa.Value = a.Value
                outn.Attributes.Append(outa)
            End If

            a = docel.GetAttributeNode("class")
            If Not a Is Nothing Then
                outa = p_Doc.CreateAttribute("class")
                outa.Value = a.Value
                outn.Attributes.Append(outa)
            End If

            'ATTRIBUTES
            Dim atts As ArrayList
            If Me.p_tag2include.ContainsKey(tag) Then
                atts = Me.p_tag2include(tag)
                For Each att As String In atts
                    a = docel.GetAttributeNode(att)
                    If Not a Is Nothing Then
                        outa = p_Doc.CreateAttribute(att)
                        outa.Value = a.Value
                        outn.Attributes.Append(outa)
                    End If
                Next
            End If

            'If tag = "A" Then
            '    a = docel.GetAttributeNode("href")
            '    If Not a Is Nothing Then
            '        outa = p_Doc.CreateAttribute("href")
            '        outa.Value = a.Value
            '        outn.Attributes.Append(outa)
            '    End If
            'End If
            'If tag = "IMG" Then
            '    a = docel.GetAttributeNode("src")
            '    If Not a Is Nothing Then
            '        outa = p_Doc.CreateAttribute("src")
            '        outa.Value = a.Value
            '        outn.Attributes.Append(outa)
            '    End If
            'End If

            '
            ' Continuo a navigare nei figli ricorsivamente
            '
            'Dim el As XmlElement
            If docel.ChildNodes.Count > 0 Then
                For Each n In docel.ChildNodes
                    ExploreHtml(n, outn)
                Next
            End If

        End If

        outel.AppendChild(outn)

    End Sub
    Private Sub StartParsingJson(ByVal json As String)

        Dim doc As XmlDocument = New XmlDocument()
        Dim reader As XmlDictionaryReader
        reader = JsonReaderWriterFactory.CreateJsonReader(Encoding.UTF8.GetBytes(json), XmlDictionaryReaderQuotas.Max)
        Dim xml As XElement = XElement.Load(reader)
        doc.LoadXml(xml.ToString())

        p_Doc = doc

    End Sub
    Private Function PurgeText(ByVal text As String) As String
        text = System.Text.RegularExpressions.Regex.Replace(text, "^\s+", "")
        text = System.Text.RegularExpressions.Regex.Replace(text, "\s+$", "")
        text = text.Replace(Chr(0), "")
        text = text.Replace(Chr(19), "")
        text = text.Replace(Chr(26), "")
        Return text
    End Function

End Class

